home *** CD-ROM | disk | FTP | other *** search
/ Business Assistant / Business Assistant.iso / acctg / hseacctg / jrnlarch.pf3 < prev    next >
Encoding:
Text File  |  1987-06-29  |  3.9 KB  |  132 lines
  1. ' ROUTINE TO PURGE RECORDS FROM journal AND PLACE THEM INTO jrnlarch
  2. ' -------------------------------------------------------------------------
  3. quiet on
  4. singlestep off
  5.  
  6. ' ----------------------input-screen accepts cutoff date-------------------
  7. label re.try
  8. let %1 = upper("abort")
  9. Input-screen load jrnlarch
  10. menu clear box 1 1 21 80 7 0
  11. menu print 10 20 7 0 Processing . . . One moment Please.
  12. repaint off
  13.  
  14. if (%1 = upper("abort")) or (len("%1") = 0) then jump all.done
  15. let $cutoff = "%1"
  16. if match(mid($cutoff,3,1),"/") = 0 then jump inv.date
  17. if match($cutoff,"/") <> 3 or match($cutoff,"/",4) <> 6 then jump inv.date
  18.  
  19. ' ---------------------screen display with start time----------------------
  20. repaint on
  21. menu clear box 1 1 21 80 7 0
  22. menu draw box 9 19 11 55 7 0
  23. menu print 10 20 7 0 Processing . . . One moment Please.
  24. let %2 = left(time,5)|right(time,1)
  25. menu print 5 17 7 0 This process can take up to fifteen minutes
  26. menu print 6 17 7 0 depending upon the number of records in the file.
  27. menu print 17 30 7 0 Start Time: %2
  28. menu print 18 30 7 0 Cutoff Date: %1
  29. repaint off
  30.  
  31. ' --------------------get rid of recon window and screen-------------------
  32. goto window 2
  33. unload screen recon
  34. close
  35.  
  36. ' -----------------load jrnlarch-------------------------------------------
  37. split horizontal 13 2
  38. goto window 2
  39. load JRNLARCH screen standard
  40.  
  41. ' -----------------select records to be archived, display count------------
  42. goto window 1
  43. query predefined ARCHIVE index ARCHIVE
  44. order index ARCHIVE
  45. if records = 0 then jump no.records
  46. let %2 = records
  47. menu print 19 20 7 0 Number of Records to Archive: %2
  48.  
  49. ' -------------------write all archive records to arch.det-----------------
  50. GOTO WINDOW 1
  51. write all [1|13] smart arch.det
  52.  
  53. ' ----this is used to delete the first record from arch.det (titles)-------
  54. goto window 2
  55. let %3 = records + 1
  56.  
  57. ' ---------------------read the records from arch.det into jrnlarch--------
  58. read smart arch.det fields [1|13]
  59. file erase arch.det
  60. ' ------------------goto first new record and delete it--------------------
  61. goto record rec-number %3
  62. delete
  63. unload file jrnlarch
  64. close
  65. utilities purge jrnlarch
  66.  
  67. ' ------------------rebuild keys after purge-------------------------------
  68. load jrnlarch screen standard
  69. key organize all
  70. unload file jrnlarch
  71.  
  72. ' ----while journal is still indexed w/ archive, get bal forward amts------
  73. goto window 1
  74. goto file journal screen enter
  75. order index archive
  76. write summarized predefined balforwd smart arch.sum
  77.  
  78. ' -------------read partial bal forward records into journal----------------------
  79. order sequential
  80. let %3 = records + 1
  81. read smart arch.sum fields [1;5]
  82. file erase arch.sum
  83. ' -------------delete the first bal forward record using %3 again----------
  84. goto record rec-number %3
  85. delete
  86.  
  87. ' --------------fill in the gaps of the partial bal forward records--------
  88. let %3 = %3 + 1
  89. while %3 <= records
  90.    goto record rec-number %3
  91.      let [2] = "DEP"
  92.      let [3] = today
  93.      let [4] = "BALANCE FORWARD DURING ARCHIVE"
  94.      let [6] = ""
  95.      let [7] = ""
  96.      let [8] = today
  97.      let [9] = today
  98.   let %3 = %3 + 1
  99. endwhile
  100.  
  101. ' -------------get rid of the deleted records------------------------------
  102. order index archive
  103. goto record rec-number 1
  104. delete
  105. while record < records
  106.   goto record next
  107.      delete
  108. endwhile
  109.  
  110. unload file journal
  111. utilities purge journal
  112.  
  113. ' ---------------rebuild keys after purge----------------------------------
  114. load journal screen standard
  115. key organize all
  116.  
  117. label all.done
  118. unload all
  119. close
  120. end
  121.  
  122. ' ------------------misc routines------------------------------------------
  123. label inv.date
  124. beep
  125. message Invalid date.        Press any key to retry.....
  126. jump re.try
  127.  
  128. label no.records
  129. beep
  130. message No records transferred to archive.
  131.  
  132.